Garbo/Garbo.cdr/mac/source/dialgmgr.sit/Dialogs ƒ/ListItem.p

Text File | 1989-11-29 | 6.3 KB | 270 lines | [TEXT/PJMM]

unit TListItem;

{        ⌐1986-1989            Bill Stackhouse                                    }
{                                Stackhouse Software                                }
{                                Natick, MA 01760                                    }

interface

{$IFC UNDEFINED UseListItem}
{$SETC UseListItem = FALSE}
{$ENDC}
{$IFC UseListItem}

    uses
        TObject, TStringDB;

    const
        maxListItems = 10;

    type
        TListItem = object(TObject)
                numListItems: 0..maxListItems;                {number of there list items}
                ListItem: array[1..maxListItems] of record
                        num: Integer;                    {number of item with this box}
                        numWords: Integer;            {}
                        maxWords: Integer;            {}
                        initiallyOn: Integer;            {}
                        wordsShown: Integer;        {}
                        box: Rect;                        {}
                        eventBox: Rect;                {}
                        updateRgn: RgnHandle;        {}
                        curList: ListHandle;            {}
                        words: TStringDB;
                    end;
                procedure TListItem.Init;
                procedure TListItem.Add (pItem: Integer;
                                            pInitiallyOn: Integer;
                                            pWordsShown: Integer);
                procedure TListItem.AddItem (pItemText: Str255);
                procedure TListItem.Revise (curDialog: DialogPtr);
                procedure TListItem.Draw (i: Integer);
                procedure TListItem.DrawAll;
                procedure TListItem.Mouse (curDialog: DialogPtr;
                                            theEvent: EventRecord);
                procedure TListItem.Get (theGroup: Integer;
                                            var theItem: Integer;
                                            var theText: Str255);
                function TListItem.Error: Integer;
                procedure TListItem.Free;
                override;
            end;

{$ENDC}

implementation

{$IFC UseListItem}

    const
        Off = 0;
        On = 1;

        btnCtrlItem = 4;
        chkCtrlItem = 5;
        radCtrlItem = 6;
        editCtrlItem = 16;

        DialogGroupIgnored = -10;    {too many groups, key, menus, or user items were added}

    type
        TSearch = (searching, found, endList);

    var
        globalError: Integer;

    procedure TListItem.Init;
    begin
        globalError := noErr;
        SELF.numListItems := 0;
    end;        {TListItem.Init}

    procedure TListItem.Add (pItem: Integer;
                                    pInitiallyOn: Integer;
                                    pWordsShown: Integer);
    begin
        globalError := noErr;
        if pInitiallyOn < 1 then
            pInitiallyOn := 1;
        if pWordsShown < 1 then
            pWordsShown := 1;
        with SELF do
            begin
                if numListItems < maxListItems then
                    begin
                        numListItems := numListItems + 1;
                        with ListItem[numListItems] do
                            begin
                                num := pItem;
                                initiallyOn := pInitiallyOn;
                                wordsShown := pWordsShown;
                                curList := nil;
                                new(words);
                                words.Init;
                            end;    {with}
                    end    {if}
                else
                    globalError := DialogGroupIgnored;
            end;
    end;        {TListItem.Add}

    procedure TListItem.AddItem (pItemText: Str255);
    begin
        globalError := noErr;
        SELF.ListItem[numListItems].words.Add(pItemText);
        if MemError <> noErr then
            globalError := DialogGroupIgnored;
    end;        {TListItem.AddItem}

    procedure TListItem.Revise (curDialog: DialogPtr);
        var
            i, j: Integer;
            theType: Integer;
            theHandle: Handle;
    begin
        globalError := noErr;
        for i := 1 to SELF.numListItems do
            with SELF.ListItem[i] do
                begin
                    GetDItem(curDialog, num, theType, theHandle, box);
                    updateRgn := NewRgn;
                    OpenRgn;
                    FrameRect(box);
                    CloseRgn(updateRgn);
                end;
    end;        {TListItem.Revise}

    procedure TListItem.Draw (i: Integer);
        var
            j: Integer;
            dataBounds: Rect;                {the following are all passed to NewList}
            cSize: Point;
            theProc: Integer;
            drawIt: Boolean;
            hasGrow: Boolean;
            scrollHoriz: Boolean;
            scrollVert: Boolean;
            outlineBox: Rect;
            word: Str255;
            theFont: FontInfo;                {info about the font used in the menu}
    begin
        globalError := noErr;
        with SELF.ListItem[i] do
            begin
                if curList = nil then
                    begin
                        GetFontInfo(theFont);
                        with theFont, box do
                            SetRect(box, left, top, right, top + (wordsShown * (ascent + descent + leading))); {l,t,r,b}
                        eventBox := box;
                        SetRect(dataBounds, 0, 0, 1, words.Count);
                        cSize.h := 0;
                        cSize.v := 0;
                        theProc := 0;
                        drawIt := TRUE;
                        hasGrow := FALSE;
                        scrollHoriz := FALSE;
                        scrollVert := (words.Count > wordsShown);
                        if scrollVert then
                            with box do
                                SetRect(box, left, top, right - 16, bottom);
                        curList := LNew(box, dataBounds, cSize, theProc, FrontWindow, drawIt, hasGrow, scrollHoriz, scrollVert);
                        for j := 1 to words.Count do
                            begin
                                cSize.h := 0;
                                cSize.v := j - 1;
                                if j = 1 then
                                    word := words.ReadFirst
                                else
                                    word := words.ReadNext;
                                LSetCell(Pointer(Longint(@word) + 1), Length(word), cSize, curList);
                            end;    {for}
                        cSize.h := 0;
                        cSize.v := initiallyOn - 1;
                        LSetSelect(TRUE, cSize, curList);
                        LAutoScroll(curList);
                    end;        {if nil}
                LUpdate(updateRgn, curList);
                outlinebox := box;
                InsetRect(outlineBox, -1, -1);
                FrameRect(outlineBox);
            end;
    end;        {TListItem.Draw}

    procedure TListItem.DrawAll;
        var
            i: Integer;
    begin
        globalError := noErr;
        for i := 1 to numListItems do
            SELF.Draw(i);
    end;        {TListItem.DrawAll}

    procedure TListItem.Mouse (curDialog: DialogPtr;
                                    theEvent: EventRecord);
        var
            i: Integer;
    begin
        globalError := noErr;
        GlobalToLocal(theEvent.where);                            {because PtInRect wants it that way}
        with SELF do
            begin
                if numListItems > 0 then
                    for i := 1 to numListItems do
                        with ListItem[i] do
                            if PtInRect(theEvent.where, eventBox) then
                                begin
                                    with theEvent do
                                        if LClick(where, modifiers, curList) then
                                            ;
                                    Leave;
                                end;            {if PtInRect}
            end;    {With}
    end;        {TListItem.Mouse}

    procedure TListItem.Get (theGroup: Integer;
                                    var theItem: Integer;
                                    var theText: Str255);
        var
            theCell: Point;
            itemTextSize: Integer;
    begin
        globalError := noErr;
        with SELF.Listitem[theGroup] do
            begin
                theCell := LLastClick(curList);
                if theCell.v < 0 then
                    begin
                        theCell.h := 0;
                        theCell.v := initiallyOn - 1;
                    end;
                itemTextSize := 255;
                LGetCell(Ptr(Longint(@theText) + 1), itemTextSize, theCell, curList);
{$R-}
                theText[0] := CHR(itemTextSize);
{$R+}
                theItem := theCell.v + 1;
            end;
    end;        {TListItem.Get}

    function TListItem.Error: Integer;
    begin
        Error := globalError;
    end;        {TListItem.Error}

    procedure TListItem.Free;
        var
            i: Integer;
    begin
        globalError := noErr;
        for i := 1 to SELF.numListItems do
            begin
                LDispose(SELF.Listitem[i].curlist);
                DisposeRgn(SELF.Listitem[i].updateRgn);
            end;
        inherited Free;
    end;        {TListItem.Free}

{$ENDC}

end.